home *** CD-ROM | disk | FTP | other *** search
/ Atari Forever 4 / Atari Forever 4.zip / Atari Forever 4.iso / SERIE_S / S_902 / ABLEITEN / ABL_GEM.GFA (.txt) next >
GFA-BASIC Atari  |  1998-03-14  |  13KB  |  594 lines
  1. ' Programm/Accessory zum Ableiten von Funktionen
  2. $m30000
  3. ON ERROR GOSUB err
  4. window_install
  5. DIM tr$(5)
  6. tr$(1)="^"
  7. tr$(2)="/"
  8. tr$(3)="*"
  9. tr$(4)="-"
  10. tr$(5)="+"
  11. a&=APPL_INIT()
  12. IF a&=0
  13.   prg!=TRUE
  14.   hand&=@openw
  15.   v_slide
  16. ELSE
  17.   menu&=MENU_REGISTER(a&,"  Ableiten")
  18.   WHILE menu&=-1  !zuviele einträge
  19.     ~EVNT_MESAG(0)
  20.   WEND
  21. ENDIF
  22. '
  23. '
  24. DO
  25.   IF hand&<>-1
  26.     haupt
  27.   ELSE
  28.     ~EVNT_MESAG(0)
  29.     fenster
  30.   ENDIF
  31. LOOP
  32. '
  33. > PROCEDURE haupt
  34.   LOCAL f|
  35.   bezg&=64        !Mit A wird die Zerlegung begonnen
  36.   '
  37.   IF EVNT_MULTI(&X110000,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,d&,d&,d&,d&,taste&,d&) AND 16
  38.     fenster
  39.   ENDIF
  40.   @cls
  41.   @print(" Symbolische Umformungen")
  42.   @print(" Dieses Programm bildet die Ableitungen von Funktionen.")
  43.   @print(" (c) Matthias Jüschke")
  44.   @print("")
  45.   REPEAT
  46.     @print(" Geben Sie den Term ein, der abgeleitet werden soll")
  47.     @print(" (Funktion laden: leere Eingabe):")
  48.     f$=@input$("f(x)=",70)
  49.     IF LEN(f$)=0
  50.       n$=""
  51.       IF @filese(n$)
  52.         IF EXIST(n$)
  53.           OPEN "i",#1,n$
  54.           LINE INPUT #1,f$
  55.           CLOSE #1
  56.         ENDIF
  57.       ENDIF
  58.     ENDIF
  59.   UNTIL LEN(f$)
  60.   @print("")
  61.   a$=@ableitung$(UPPER$(f$),ASC("Y"))
  62.   @print("")
  63.   @print(" Die Ableitung lautet:")
  64.   @print("f'(x)="+a$)
  65.   @print(" - Taste - ")
  66.   ALERT 1,"Ableitung|speichern?",2,"Ja|Nein",f|
  67.   IF f|=1
  68.     IF @filese(n$)
  69.       OPEN "O",#1,n$+".FKT"
  70.       PRINT #1,a$
  71.       PRINT #1,"ist die Ableitung der Funktion:"
  72.       PRINT #1,f$
  73.       CLOSE #1
  74.     ENDIF
  75.   ENDIF
  76.   ~@key
  77. RETURN
  78. > PROCEDURE window_install
  79.   hand&=-1
  80.   wx&=0
  81.   wy&=51
  82.   ww&=480
  83.   wh&=262
  84.   line_anz&=(wh&-38)/16
  85.   x_aufl&=WORK_OUT(0)
  86.   y_aufl&=WORK_OUT(1)
  87.   text&=0
  88.   lines&=50
  89.   DIM t$(lines&)
  90. RETURN
  91. > FUNCTION openw
  92.   hand&=WIND_CREATE(&X111101111,wx&,wy&,x_aufl&,y_aufl&)
  93.   '   vslide,Pf-up,down,Size,,move,full,close,name
  94.   titel$=" Ableiten "+CHR$(0) !titelw
  95.   ~WIND_SET(hand&,2,CARD(SWAP(V:titel$)),CARD(V:titel$),0,0) !Titel
  96.   IF WIND_OPEN(hand&,wx&,wy&,ww&,wh&)=0
  97.     OUT 2,7
  98.     ~WIND_DELETE(hand&)
  99.     hand&=-1
  100.   ELSE
  101.     v_slide
  102.   ENDIF
  103.   RETURN hand&
  104. ENDFUNC
  105. > PROCEDURE fenster
  106.   LOCAL wx1&,wy1&,ww1&,wh1&
  107.   IF MENU(1)=40
  108.     IF hand&=-1 AND prg!=0
  109.       hand&=@openw
  110.     ELSE
  111.       ~WIND_SET(hand&,10,0,0,0,0) !TOPW
  112.     ENDIF
  113.   ENDIF
  114.   ' IF hand&=MENU(4), außer bei 41
  115.   SELECT MENU(1)
  116.   CASE 20               !REDRAW
  117.     DEFMOUSE 2
  118.     ~WIND_GET(hand&,11,wx1&,wy1&,ww1&,wh1&)
  119.     REPEAT
  120.       IF RC_INTERSECT(MENU(5),MENU(6),MENU(7),MENU(8),wx1&,wy1&,ww1&,wh1&)
  121.         CLIP wx1&,wy1&,ww1&,wh1&
  122.         redraw
  123.       ENDIF
  124.       ~WIND_GET(hand&,12,wx1&,wy1&,ww1&,wh1&)
  125.     UNTIL ww1&=0 OR wh1&=0
  126.     DEFMOUSE 0
  127.     CLIP wx&+1,wy&+19,ww&-20,wh&-38
  128.   CASE 21,29            !TOPW
  129.     ~WIND_SET(hand&,10,0,0,0,0)
  130.   CASE 22,41            !CLOSEW
  131.     IF hand&>-1
  132.       ~WIND_GET(hand&,5,wx&,wy&,ww&,wh&)
  133.       IF ww&>0 AND wh&>0
  134.         ~WIND_CLOSE(hand&)
  135.         ~WIND_DELETE(hand&)
  136.         IF prg!
  137.           END
  138.         ENDIF
  139.       ENDIF
  140.     ENDIF
  141.     hand&=-1
  142.   CASE 23               !FULLW
  143.     ~WIND_SET(hand&,5,0,19,x_aufl&,y_aufl&-19)
  144.     ~WIND_GET(hand&,5,wx&,wy&,ww&,wh&)
  145.     line_anz&=(wh&-38)/16
  146.     CLIP wx&+1,wy&+19,ww&-20,wh&-38
  147.     v_slide
  148.   CASE 24               !ARROWED
  149.     wx1&=v_s&
  150.     SELECT MENU(5)
  151.     CASE 0      !über Pf
  152.       v_s&=MAX(v_s&-line_anz&,0)
  153.     CASE 1      !unter Pf
  154.       v_s&=MIN(v_s&+line_anz&,text&-line_anz&)
  155.     CASE 2      !Pf oben
  156.       v_s&=MAX(v_s&-1,0)
  157.     CASE 3      !pf unten
  158.       v_s&=MIN(v_s&+1,MAX(text&-line_anz&,0))
  159.     ENDSELECT
  160.     IF v_s&<>wx1&
  161.       v_slide
  162.       redraw
  163.     ENDIF
  164.   CASE 26               !VSLID
  165.     ~WIND_SET(hand&,9,MENU(5),0,0,0) !auf Pos.setzen
  166.     v_s&=(MENU(5)*(text&-line_anz&)+500)/1000
  167.     redraw
  168.   CASE 27               !SIZE
  169.     ~WIND_SET(hand&,5,MENU(5),MENU(6),MAX((MENU(7) AND &H0)+3,155-16),MAX((MENU(8) AND &H0)+6,150))
  170.     ~WIND_GET(hand&,5,wx&,wy&,ww&,wh&)
  171.     line_anz&=(wh&-38)/16
  172.     CLIP wx&+1,wy&+19,ww&-20,wh&-38
  173.     IF v_s&>text&-line_anz&    !kein nicht erlaubter Bereich
  174.       v_s&=MAX(text&-line_anz&,0)
  175.     ENDIF
  176.     v_slide
  177.   CASE 28               !MOVEW
  178.     wx&=MENU(5) AND &H1       !in 4er Schritten
  179.     wy&=(MENU(6) AND &H1)+3
  180.     ~WIND_SET(hand&,5,wx&,wy&,ww&,wh&)
  181.     CLIP wx&+1,wy&+19,ww&-20,wh&-38
  182.   ENDSELECT
  183. RETURN
  184. > PROCEDURE v_slide
  185.   ' Größe und Positionierung des Vertikalen Schiebers
  186.   LOCAL a&
  187.   a&=1000
  188.   IF text&
  189.     a&=(line_anz&)/text&*1000
  190.   ENDIF
  191.   ~WIND_SET(hand&,16,a&,0,0,0)   !Größe
  192.   IF text&-line_anz&
  193.     a&=v_s&/(text&-line_anz&)*1000
  194.   ENDIF
  195.   ~WIND_SET(hand&,9,a&,0,0,0)   !Position
  196. RETURN
  197. > PROCEDURE redraw
  198.   LOCAL i&
  199.   DEFFILL 0,0,0
  200.   PBOX wx&,wy&+19,wx&+ww&-19,wy&+wh&-19
  201.   FOR i&=v_s& TO MIN(text&+line_anz&,lines&)
  202.     TEXT wx&,wy&+(i&-v_s&)*16+16,t$(i&)
  203.   NEXT i&
  204. RETURN
  205. '
  206. > PROCEDURE print(t$)
  207.   LOCAL i&,fertig!,redraw!
  208.   REPEAT
  209.     fertig!=TRUE
  210.     INC text&
  211.     IF text&>lines&
  212.       text&=lines&
  213.       FOR i&=2 TO lines&
  214.         SWAP t$(i&-1),t$(i&)
  215.       NEXT i&
  216.       redraw!=TRUE
  217.     ENDIF
  218.     t$(text&)=LEFT$(t$,76)
  219.     IF LEN(t$)>76
  220.       t$=RIGHT$(t$,LEN(t$)-76)
  221.       fertig!=FALSE
  222.     ENDIF
  223.     IF v_s&+line_anz&<text& OR redraw!
  224.       v_s&=MAX(text&-line_anz&,0)
  225.       IF fertig!
  226.         redraw
  227.         v_slide
  228.       ENDIF
  229.     ELSE
  230.       TEXT wx&,wy&+text&*16+16,t$(text&)
  231.     ENDIF
  232.   UNTIL fertig!
  233. RETURN
  234. > PROCEDURE cls
  235.   LOCAL i&
  236.   DEFFILL 0,0,0
  237.   PBOX wx&,wy&+19,wx&+ww&-19,wy&+wh&-19
  238.   FOR i&=0 TO lines&
  239.     t$(i&)=""
  240.   NEXT i&
  241.   text&=0
  242.   v_s&=0
  243.   v_slide
  244. RETURN
  245. > FUNCTION key
  246.   LOCAL rueck&
  247.   REPEAT
  248.     rueck&=EVNT_MULTI(&X10001,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,d&,d&,d&,d&,taste&,d&)
  249.     IF rueck& AND 10000
  250.       fenster
  251.     ENDIF
  252.   UNTIL rueck& AND 1
  253.   RETURN taste&
  254. ENDFUNC
  255. > FUNCTION filese(VAR n$)
  256.   LOCAL ok&,p$
  257.   p$=CHR$(GEMDOS(25)+65)+":"+DIR$(0)+"\*.FKT"
  258.   ~FSEL_INPUT(p$,n$,ok&)
  259.   n$=LEFT$(p$,RINSTR(p$,"\"))+n$
  260.   RETURN ok&
  261. ENDFUNC
  262. > FUNCTION input$(t$,len&)
  263.   LOCAL rueck&,ret$,asc|,scan|
  264.   print(t$+"_")
  265.   REPEAT
  266.     rueck&=EVNT_MULTI(&X10001,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,d&,d&,d&,d&,taste&,d&)
  267.     '                                                   ^adr.buf
  268.     IF rueck& AND 1             !tastatur
  269.       asc|=taste& AND 255
  270.       scan|=(taste& DIV 256) AND 255
  271.       SELECT asc|
  272.       CASE 8
  273.         IF LEN(ret$)
  274.           ret$=LEFT$(ret$,LEN(ret$)-1)
  275.         ENDIF
  276.       CASE 32 TO 255
  277.         IF LEN(ret$)<len&
  278.           ret$=ret$+CHR$(asc|)
  279.         ENDIF
  280.       ENDSELECT
  281.       DEC text&
  282.       print(t$+ret$+"_ ")
  283.     ENDIF
  284.     IF rueck& AND &X10000
  285.       fenster
  286.     ENDIF
  287.   UNTIL asc|=13
  288.   RETURN ret$
  289. ENDFUNC
  290. > PROCEDURE err
  291.   t%=TIMER
  292.   REPEAT
  293.     OUT 2,7
  294.   UNTIL TIMER-t%>40
  295.   IF prg!
  296.     END
  297.   ELSE
  298.     DO
  299.       ON MENU 10000
  300.     LOOP
  301.   ENDIF
  302. RETURN
  303. '
  304. '
  305. '
  306. > FUNCTION ableitung$(f$,bez&)
  307.   LOCAL t&,bezz&,pos&,a$,b$,a_abl$,b_abl$,ret$,vorz!
  308.   ' t& :gibt, wenn sich f$ trennen läßt, den Wert der Trennung an
  309.   ' bezz& :da bezg& verändert wird, der Wert aber noch benötigt wird
  310.   ' pos& :die Stelle, an der f$ getrennt werden muß
  311.   ' a$,b$ :bei t&>0 die Teilstrings bei t&>0
  312.   '        sonst a$: elementare Funktion, b$:innere Funktion
  313.   ' a_abl$,b_abl$ :bei t&>0 die Ableitungen von a$ und b$
  314.   ' vorz! :das Vorzeichen von f$ (negativ=TRUE)
  315.   '
  316.   @print(CHR$(bez&)+"="+f$) !,
  317.   vorz!=@vorz(f$)
  318.   '
  319.   IF f$=""
  320.     @print("")
  321.     @print("Fehler: *,/,^ falsch gesetzt oder leere Eingabe/Klammer")
  322.   ENDIF
  323.   '
  324.   t&=@trenn(f$,pos&)
  325.   '
  326.   IF t&=0
  327.     IF @const(f$)
  328.       ret$="0"
  329.     ELSE IF f$="X"
  330.       ret$="1"
  331.     ELSE
  332.       pos&=INSTR(f$,"(")
  333.       IF pos&>1 AND RIGHT$(f$)=")"
  334.         INC bezg&
  335.         a$=LEFT$(f$,pos&-1)
  336.         @print(CHR$(bez&)+"="+a$+"("+CHR$(bezg&)+")")
  337.         b$=MID$(f$,pos&+1,LEN(f$)-pos&-1)
  338.         b_abl$=@ableitung$(b$,bezg&)
  339.         IF a$="SIN"
  340.           ret$=@mul$(b_abl$,"COS("+b$+")")
  341.         ELSE IF a$="COS"
  342.           ret$=@mul$(b_abl$,"-SIN("+b$+")")
  343.         ELSE IF a$="TAN"
  344.           ret$=@div$(b_abl$,@hoch$("COS("+b$+")","2"))
  345.         ELSE IF a$="COT"
  346.           ret$=@div$("-"+b_abl$,@hoch$("SIN("+b$+")","2"))
  347.         ELSE IF a$="ASIN"
  348.           ret$=@div$(b_abl$,"SQRT(1-"+@hoch$(b$,"2")+")")
  349.         ELSE IF a$="ACOS"
  350.           ret$=@div$("-"+b_abl$,"SQRT(1-"+@hoch$(b$,"2")+")")
  351.         ELSE IF a$="ATAN"
  352.           ret$=@div$(b_abl$,@add$("1",@hoch$(b$,"2")))
  353.         ELSE IF a$="ACOT"
  354.           ret$=@div$("-"+b_abl$,@add$("1",@hoch$(b$,"2")))
  355.         ELSE IF a$="SINH"
  356.           ret$=@mul$(b_abl$,"COSH("+b$+")")
  357.         ELSE IF a$="COSH"
  358.           ret$=@mul$(b_abl$,"SINH("+b$+")")
  359.         ELSE IF a$="TANH"
  360.           ret$=@mul$(b_abl$,"1-TANH("+b$+")^2")
  361.         ELSE IF a$="COTH"
  362.           ret$=@mul$(b_abl$,"1-COTH("+b$+")^2")
  363.         ELSE IF a$="ASINH"
  364.           ret$=@div$(b_abl$,"SQRT(1+"+@hoch$(b$,"2")+")")
  365.         ELSE IF a$="ACOSH"
  366.           ret$=@div$(b_abl$,"SQRT("+@hoch$(b$,"2")+"-1)")
  367.         ELSE IF a$="ATANH"
  368.           ret$=@div$(b_abl$,"1-"+@hoch$(b$,"2"))
  369.         ELSE IF a$="ACOTH"
  370.           ret$=@div$(b_abl$,"1-"+@hoch$(b$,"2"))
  371.         ELSE IF a$="SQRT"
  372.           ret$=@div$(b_abl$,@mul$("2","SQRT("+b$+")"))
  373.         ELSE IF a$="EXP"
  374.           ret$=@mul$(b_abl$,f$)
  375.         ELSE IF a$="LN"
  376.           ret$=@div$(b_abl$,b$)
  377.         ELSE IF a$="LOG"
  378.           ret$=@div$(b_abl$,@mul$("LN(10)",b$))
  379.         ELSE
  380.           @print("Fehler: "+a$+"() unbekannt")
  381.           ret$=f$+"'"
  382.         ENDIF
  383.       ELSE
  384.         @print("Fehler: "+f$+" ist unverständlich")
  385.         ret$=f$+"'"
  386.       ENDIF
  387.     ENDIF
  388.   ELSE !IF t&>0
  389.     ADD bezg&,2
  390.     a$=MID$(f$,1,pos&-1)
  391.     b$=MID$(f$,pos&+1)
  392.     IF vorz!
  393.       @print("-")
  394.     ENDIF
  395.     @print(CHR$(bez&)+"="+CHR$(bezg&-1)+tr$(t&)+CHR$(bezg&)+",  "+CHR$(bezg&-1)+"="+a$+",  "+CHR$(bezg&)+"="+b$)
  396.     '
  397.     bezz&=bezg&
  398.     a_abl$=@ableitung$(a$,bezg&-1)
  399.     b_abl$=@ableitung$(b$,bezz&)
  400.     '
  401.     IF t&=5       !add
  402.       ret$=@add$(a_abl$,b_abl$)
  403.       @print(CHR$(bez&+32)+"="+CHR$(bezz&-1+32)+"+"+CHR$(bezz&+32)) !,
  404.     ELSE IF t&=4  !sub
  405.       ret$=@sub$(a_abl$,b_abl$)
  406.       @print(CHR$(bez&+32)+"="+CHR$(bezz&-1+32)+"-"+CHR$(bezz&+32)) !,
  407.     ELSE IF t&=3  !mul
  408.       ret$=@add$(@mul$(a_abl$,b$),@mul$(a$,b_abl$))
  409.       @print(CHR$(bez&+32)+"="+CHR$(bezz&-1+32)+"*"+CHR$(bezz&)+"+"+CHR$(bezz&-1)+"*"+CHR$(bezz&+32)) !,
  410.     ELSE IF t&=2  !div
  411.       ret$=@div$(@sub$(@mul$(a_abl$,b$),@mul$(a$,b_abl$)),@hoch$(b$,"2"))
  412.       @print(CHR$(bez&+32)+"=("+CHR$(bezz&-1+32)+"*"+CHR$(bezz&)+"-"+CHR$(bezz&-1)+"*"+CHR$(bezz&+32)+")/"+CHR$(bezz&)+"^2") !,
  413.     ELSE IF t&=1  !hoch
  414.       IF VAL?(b$)=LEN(b$) !f^C
  415.         ret$=@mul$(@mul$(a_abl$,b$),@hoch$(a$,STR$(VAL(b$)-1)))
  416.         @print(CHR$(bez&+32)+"="+CHR$(bezz&-1+32)+"*"+CHR$(bezz&)+"*"+CHR$(bezz&-1)+"^("+CHR$(bezz&)+"-1)") !,
  417.       ELSE                !f^g
  418.         IF a$<>"E"
  419.           ret$=@mul$(@add$(@mul$(@div$(a_abl$,a$),b$),@mul$("LN("+a$+")",b_abl$)),f$)
  420.           @print(CHR$(bez&+32)+"=("+CHR$(bezz&-1+32)+"/"+CHR$(bezz&-1)+"*"+CHR$(bezz&)+"+LN("+CHR$(bezz&+32)+")*"+CHR$(bezz&+32)+")*"+CHR$(bez&)) !,
  421.         ELSE    !E^g
  422.           ret$=@mul$(@add$(@mul$(@div$(a_abl$,a$),b$),b_abl$),f$)
  423.           @print(CHR$(bez&+32)+"=("+CHR$(bezz&-1+32)+"/"+CHR$(bezz&-1)+"*"+CHR$(bezz&)+"+"+CHR$(bezz&+32)+")*"+CHR$(bez&)) !,
  424.         ENDIF
  425.       ENDIF
  426.     ENDIF
  427.   ENDIF
  428.   IF vorz!
  429.     ret$=@mul$(ret$,"-1")
  430.     f$="-"+f$
  431.   ENDIF
  432.   IF (f$="X" OR @const(f$))=FALSE AND t&=0
  433.     @print(CHR$(bez&)+"="+f$) !,
  434.   ENDIF
  435.   @print(CHR$(bez&+32)+"="+ret$)
  436.   RETURN ret$
  437. ENDFUNC
  438. > FUNCTION vorz(VAR f$)
  439.   LOCAL vorz!,a$,pos&
  440.   ' vorz! :das Vorzeichen, Rückgabewert (negativ=TRUE)
  441.   ' a$ :zur Kontrolle, ob abgebrochen werden kann
  442.   ' pos& :nicht weiter benötigte Variable für den @trenn()-Aufruf
  443.   '
  444.   REPEAT
  445.     a$=f$
  446.     IF LEFT$(f$)="+"
  447.       f$=MID$(f$,2,LEN(f$)-1)
  448.     ENDIF
  449.     '
  450.     ' Der @trenn()-Aufruf verhindert, das der gesamten Funktion
  451.     ' ein falsches Vorzeichen gegeben wird.
  452.     IF LEFT$(f$)="-" AND @trenn(f$,pos&)<=3
  453.       IF vorz!
  454.         vorz!=FALSE
  455.       ELSE
  456.         vorz!=TRUE
  457.       ENDIF
  458.       f$=MID$(f$,2,LEN(f$)-1)
  459.     ENDIF
  460.     f$=@kl_weg$(f$)
  461.   UNTIL a$=f$
  462.   RETURN vorz!
  463. ENDFUNC
  464. > FUNCTION trenn(f$,VAR pos&)
  465.   LOCAL i&,a$,kl&,j&,t&,eben!
  466.   ' i& :die Postition des aktuellen Zeichens
  467.   ' a$ :das aktuelle Zeichen
  468.   ' kl& :die Anzahl der bei i& geöffneten Klammern
  469.   ' j& :Schleifenvariable, zum Suchen einer neuen Trennstelle benötigt
  470.   ' t& :der Wert der aktuellen Trennstelle, Rückgabewert
  471.   ' eben! :gibt an, ob letztes a$ Verknüpfungszeichen war (dann TRUE),
  472.   '       also Vorzeichen folgen können (daher erst TRUE)
  473.   i&=1
  474.   pos&=1
  475.   a$="*"
  476.   REPEAT
  477.     IF (a$="+" OR a$="-")=FALSE
  478.       eben!=(a$="*" OR a$="/" OR a$="^")
  479.     ENDIF
  480.     a$=MID$(f$,i&,1)
  481.     IF a$="("
  482.       INC kl&
  483.     ELSE IF a$=")"
  484.       DEC kl&
  485.     ENDIF
  486.     IF kl&=0
  487.       FOR j&=5 DOWNTO 1
  488.         IF a$=tr$(j&) AND j&=>t&
  489.           IF j&<4 OR eben!=FALSE
  490.             t&=j&
  491.             pos&=i&
  492.           ENDIF
  493.         ENDIF
  494.       NEXT j&
  495.     ENDIF
  496.     INC i&
  497.   UNTIL i&>=LEN(f$)
  498.   RETURN t&
  499. ENDFUNC
  500. > FUNCTION klammer$(f$,wert&)
  501.   LOCAL t&,pos&
  502.   ' t& :Wert der Trennstelle
  503.   ' pos& :für den @trenn()-Aufruf, dummy
  504.   '
  505.   t&=@trenn(f$,pos&)
  506.   IF wert&<t&
  507.     f$="("+f$+")"
  508.   ENDIF
  509.   RETURN f$
  510. ENDFUNC
  511. > FUNCTION kl_weg$(f$)
  512.   LOCAL t&,pos&
  513.   ' t& :Wert der Trennstelle
  514.   ' pos& :für den @trenn()-Aufruf, dummy
  515.   '
  516.   WHILE LEFT$(f$)="(" AND RIGHT$(f$)=")" AND t&=0
  517.     t&=@trenn(f$,pos&)
  518.     IF t&=0
  519.       f$=MID$(f$,2,LEN(f$)-2)
  520.       IF INSTR(f$,"(")>INSTR(f$,")")
  521.         f$="("+f$+")"
  522.         t&=1
  523.       ENDIF
  524.       ' Wenn bei (x)(x+3) ("*" fehlt) die Klammern gelöscht wurden
  525.       ' werden sie wieder hinzugefügt, um übersichtlicher zu
  526.       ' bleiben. Der Fehler wird später ausgegeben.
  527.     ENDIF
  528.   WEND
  529.   RETURN f$
  530. ENDFUNC
  531. '
  532. > FUNCTION add$(a$,b$)
  533.   IF a$="0"
  534.     RETURN b$
  535.   ELSE IF b$="0"
  536.     RETURN a$
  537.   ENDIF
  538.   RETURN a$+"+"+b$
  539. ENDFUNC
  540. > FUNCTION sub$(a$,b$)
  541.   b$=@klammer$(b$,3)
  542.   IF b$="0"
  543.     RETURN a$
  544.   ELSE IF a$="0"
  545.     RETURN "-"+b$
  546.   ENDIF
  547.   a$=@klammer$(a$,5)
  548.   RETURN a$+"-"+b$
  549. ENDFUNC
  550. > FUNCTION mul$(a$,b$)
  551.   IF a$="0" OR b$="0"
  552.     RETURN "0"
  553.   ELSE IF a$="1"
  554.     RETURN b$
  555.   ELSE IF b$="1"
  556.     RETURN a$
  557.   ELSE IF b$="-1"
  558.     RETURN "-"+@klammer$(a$,3)
  559.   ENDIF
  560.   a$=@klammer$(a$,3)
  561.   b$=@klammer$(b$,3)
  562.   RETURN a$+"*"+b$
  563. ENDFUNC
  564. > FUNCTION div$(a$,b$)
  565.   IF a$="0" AND b$<>"0"
  566.     RETURN "0"
  567.   ELSE IF b$="1"
  568.     RETURN a$
  569.   ENDIF
  570.   a$=@klammer$(a$,3)
  571.   b$=@klammer$(b$,1)
  572.   RETURN a$+"/"+b$
  573. ENDFUNC
  574. > FUNCTION hoch$(a$,b$)
  575.   IF b$="1"
  576.     RETURN a$
  577.   ELSE IF b$="0" AND a$<>"0"
  578.     RETURN "1"
  579.   ELSE IF a$="0" AND b$<>"0"
  580.     RETURN "0"
  581.   ENDIF
  582.   a$=@klammer$(a$,1)
  583.   b$=@klammer$(b$,0)
  584.   RETURN a$+"^"+b$
  585. ENDFUNC
  586. '
  587. > FUNCTION const(a$)
  588.   IF LEN(a$)=VAL?(a$) OR a$="A" OR a$="E"
  589.     RETURN TRUE
  590.   ELSE
  591.     RETURN FALSE
  592.   ENDIF
  593. ENDFUNC
  594.